home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d19
/
gw15pak.arc
/
GWTERM10.ARC
/
SOURCE.ARC
/
ASYNC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-18
|
8KB
|
238 lines
{$B-} { Short circuit boolean ON }
{$I-} { I/O checking OFF }
{$R-} { Range checking OFF }
{$S-} { Stack checking OFF }
{$V-} { Var-str checking OFF}
UNIT ASYNC;
{PD async unit debugged and modified for doorgame use by Joel Bergen}
{added com3 & com4 support and xon/xoff handshaking }
INTERFACE
USES Dos,CRT;
CONST
Async_Buffer_Max = 1024; { size of input buffer }
VAR
Async_OriginalVector : pointer;
Async_Buffer : Array[0..Async_Buffer_Max] of char;
Async_Open_Flag : Boolean; { true if Open but no Close }
Async_Pause : Boolean; { true if paused (Xoff received) }
Async_Port : Integer; { current Open port number (1..4) }
Async_Base : Integer; { base for current open port }
Async_Irq : Integer; { irq for current open port }
Async_Buffer_Overflow: Boolean; { True if buffer overflow has happened }
Async_Buffer_Used : Word; { number of characters in input buffer }
{ Async_Buffer is empty if Head = Tail }
Async_Buffer_Head : Word; { Locn in Async_Buffer to put next char }
Async_Buffer_Tail : Word; { Locn in Async_Buffer to get next char }
{----------------------------------------------------------------------------}
{ USER CALLABLE ROUTINES }
{----------------------------------------------------------------------------}
PROCEDURE Async_Init;
{ initialize variables, call first to initialize }
PROCEDURE Async_Close;
{ reset the interrupt system when UART interrupts no longer needed }
{ Turn off the COM port interrupts. }
{ **MUST** BE CALLED BEFORE EXITING YOUR PROGRAM; otherwise you }
{ will see some really strange errors and have to re-boot. }
FUNCTION Async_Open(ComPort,BaudRate : Word) : Boolean;
{ open a communications port at 8/n/1 with supplied port & baud }
{ Sets up interrupt vector, initialies the COM port for }
{ processing, sets pointers to the buffer. Returns FALSE if COM }
{ port not installed. }
FUNCTION Async_Buffer_Check : Boolean;
{ see if a character has been received }
{ If a character is available, returns TRUE }
{ Otherwise, returns FALSE }
FUNCTION Async_Read : Char;
{ read a character, assuming it is ready}
PROCEDURE Async_Send(C : Char);
{ transmit a character }
PROCEDURE Async_Hangup;
{ drop carrier by dropping DTR}
FUNCTION Async_CarrierDetect : BOOLEAN;
{ true if carrier detected }
{----------------------------------------------------------------------------}
IMPLEMENTATION
CONST
I8088_IMR = $21; { port address of the Interrupt Mask Register }
AsyncBasePort : Array[1..4] OF WORD = ($03F8,$02F8,$03E8,$02E8);
AsyncIRQ : Array[1..4] OF WORD = (4,3,4,3);
PROCEDURE DisableInterrupts; inline($FA {cli} ); {MACROS}
PROCEDURE EnableInterrupts; inline($FB {sti} );
PROCEDURE Async_Isr; INTERRUPT;
{ Interrupt Service Routine
Invoked when the UART has received a byte of data from the
communication line }
CONST
Xon = #17; {^q resume}
Xoff = #19; {^s pause}
VAR
c : Char;
BEGIN
EnableInterrupts;
IF Async_Buffer_Used < Async_Buffer_Max THEN BEGIN
c := CHR(Port[Async_Base]);
CASE c OF
Xoff : Async_Pause:=TRUE;
Xon : Async_Pause:=FALSE;
ELSE BEGIN
Async_Pause:=FALSE;
Async_Buffer[Async_Buffer_Head] := c;
IF Async_Buffer_Head < Async_Buffer_Max THEN
Inc(Async_Buffer_Head)
ELSE
Async_Buffer_Head := 0;
Inc(Async_Buffer_Used);
END;
END;
END ELSE Async_Buffer_Overflow := TRUE;
DisableInterrupts;
Port[$20] := $20;
END; { Async_Isr }
PROCEDURE Async_Init;
{ initialize variables }
BEGIN
Async_Open_Flag := FALSE;
Async_Buffer_Head := 0;
Async_Buffer_Tail := 0;
Async_Buffer_Overflow := FALSE;
Async_Buffer_Used := 0;
Async_Pause := FALSE;
END; { Async_Init }
PROCEDURE Async_Close;
{ reset the interrupt system when UART interrupts no longer needed }
VAR
i, m : INTEGER;
BEGIN
IF Async_Open_Flag THEN BEGIN
DisableInterrupts; { disable IRQ on 8259 }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := 1 shl Async_Irq; { set mask to turn off interrupt }
Port[I8088_IMR] := i or m;
Port[Async_Base + 1] := 0; { disable 8250 data ready interrupt}
EnableInterrupts;
SetIntVec(Async_Irq + 8,Async_OriginalVector);
Async_Open_Flag := FALSE { flag port as closed }
END
END; { Async_Close }
FUNCTION Async_Open(ComPort,BaudRate : WORD) : Boolean;
{ open a communications port. This unit will only open 1 port at a time }
VAR
i, m : INTEGER;
b : Byte;
BEGIN
IF Async_Open_Flag THEN Async_Close;
Async_Port := ComPort;
Async_Base := AsyncBasePort[Async_Port];
Async_Irq := AsyncIRQ[Async_Port];
IF (Port[Async_Base + 2] AND $00F8) <> 0 THEN
Async_Open := FALSE
ELSE BEGIN
{ set comm parameters }
Port[Async_Base + 3] := $03; {set 8/n/1. Yes, this shouldn't be hardcoded}
{ set ISR vector }
GetIntVec(Async_Irq + 8, Async_OriginalVector);
SetIntVec(Async_Irq + 8, @Async_Isr);
{ read the RBR and reset any possible pending error conditions }
{ first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
DisableInterrupts;
Port[Async_Base + 3] := Port[Async_Base + 3] AND $7F;
{ read the Line Status Register to reset any errors it indicates }
i := Port[Async_Base + 5];
{ read the Receiver Buffer Register in case it contains a character }
i := Port[Async_Base];
{ enable the irq on the 8259 controller }
i := Port[I8088_IMR]; { get the interrupt mask register }
m := (1 shl Async_Irq) XOR $00FF;
Port[I8088_IMR] := i AND m;
{ enable the data ready interrupt on the 8250 }
Port[Async_Base + 1] := $01; { enable data ready interrupt }
{ enable OUT2 on 8250 }
i := Port[Async_Base + 4];
Port[Async_Base + 4] := i OR $08;
EnableInterrupts;
{ Set baudrate}
b := Port[3+Async_Base] OR 128;
Port[3+Async_Base]:= b;
Port[Async_Base] := lo(trunc(115200.0/BaudRate));
Port[1+Async_Base]:= hi(trunc(115200.0/BaudRate));
Port[3+Async_Base]:= b AND 127;
{ set flags }
Async_Open_Flag := TRUE;
Async_Open := TRUE
END
END; { Async_Open }
FUNCTION Async_Buffer_Check : Boolean;
{ return true if character ready to receive }
BEGIN
Async_Buffer_Check := (Async_Buffer_Used <> 0);
END; { Async_Buffer_Check }
FUNCTION Async_Read : Char;
{ return char, use Async_Buffer_Check first! }
BEGIN
Async_Read := Async_Buffer[Async_Buffer_Tail];
Inc(Async_Buffer_Tail);
IF Async_Buffer_Tail > Async_Buffer_Max THEN
Async_Buffer_Tail := 0;
Dec(Async_Buffer_Used);
END; { Async_Buffer_Check }
PROCEDURE Async_Send(c : CHAR);
{ transmit a character }
BEGIN
Port[Async_Base + 4] := $0B; {turn on OUT2, DTR, and RTS}
WHILE (Port[Async_Base + 6] AND $10) = 0 DO; {wait for CTS}
WHILE (Port[Async_Base + 5] AND $20) = 0 DO; {wait for Tx Holding Reg Empty}
WHILE Async_Pause AND Async_CarrierDetect DO; {wait for Xon}
DisableInterrupts;
Port[Async_Base] := Ord(c); {send the character}
EnableInterrupts;
END; { Async_Send }
PROCEDURE Async_Hangup;
BEGIN
Port[Async_Base+4] := $00; {dtr off}
Delay(1000); {wait 1 second}
Port[Async_Base+4] := $03; {dtr on}
END;
FUNCTION Async_CarrierDetect : BOOLEAN;
{true if carrier}
VAR
b : BOOLEAN;
w : WORD;
BEGIN
w:=0; b:=TRUE;
WHILE (w<500) AND b DO BEGIN {make sure carrier stays down}
Inc(w); {and is not just a fluke }
b:=(PORT[Async_Base+6] AND 128) <> 128; {true = no carrier};
END;
Async_CarrierDetect := NOT b;
END;
END. { ASYNC UNIT }